(define-module (nongnu bootloader refind)
  #:use-module (guix records)
  #:use-module ((guix utils) #:select (%current-system))
  #:use-module (guix gexp)
  #:use-module (gnu artwork)
  #:use-module (gnu bootloader)
  #:use-module (gnu system uuid)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system keyboard)
  #:use-module (gnu packages bootloaders)
  #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
  #:autoload   (gnu packages xorg) (xkeyboard-config)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-2)
  #:export (refind-bootloader))

(define (strip-mount-point mount-point file)
  "Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object
denoting a file name."
  (match mount-point
    ((? string? mount-point)
     (if (string=? mount-point "/")
         file
         #~(let ((file #$file))
             (if (string-prefix? #$mount-point file)
                 (substring #$file #$(string-length mount-point))
                 file))))
    (#f file)))

(define* (refind-configuration-file config entries
                                    #:key
                                    (system (%current-system))
                                    (old-entries '()))
  "Return the GRUB configuration file corresponding to CONFIG, a
<bootloader-configuration> object, and where the store is available at
STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system."
  (define all-entries
    (append entries (bootloader-configuration-menu-entries config)))
  (define (menu-entry->gexp entry)
    (let ((device (menu-entry-device entry))
          (device-mount-point (menu-entry-device-mount-point entry))
          (label (menu-entry-label entry))
          (kernel (menu-entry-linux entry))
          (arguments (menu-entry-linux-arguments entry))
          (initrd (menu-entry-initrd entry)))
      ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
      ;; Use the right file names for KERNEL and INITRD in case
      ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
      ;; separate partition.
      (let ((kernel  (strip-mount-point device-mount-point kernel))
            (initrd  (strip-mount-point device-mount-point initrd)))
        #~(begin
            (system* "cp" "--parents" #$kernel (string-append device-mount-point "/boot/efi/EFI/guix"))
            (system* "cp" "--parents" #$initrd (string-append device-mount-point "/boot/efi/EFI/guix")))
        #~(format port " ~s {
    icon /EFI/refind/icons/os_linux.png
    loader /EFI/guix~a
    initrd /EFI/guix~a
    options \"~a\"~%"
                  #$label
                  #$kernel
                  #$initrd
                  (string-join (list #$@arguments))))))
  (define (submenu-entry->gexp entry)
    (let ((device (menu-entry-device entry))
          (device-mount-point (menu-entry-device-mount-point entry))
          (label (menu-entry-label entry))
          (kernel (menu-entry-linux entry))
          (arguments (menu-entry-linux-arguments entry))
          (initrd (menu-entry-initrd entry)))
      ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
      ;; Use the right file names for KERNEL and INITRD in case
      ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
      ;; separate partition.
      (let ((kernel  (strip-mount-point device-mount-point kernel))
            (initrd  (strip-mount-point device-mount-point initrd)))
        #~(begin
            (system* "cp" "--parents" #$kernel (string-append device-mount-point "/EFI/guix"))
            (system* "cp" "--parents" #$initrd (string-append device-mount-point "/EFI/guix")))
        #~(format port "    submenuentry ~s {
        icon /EFI/refind/icons/os_linux.png
        loader /EFI/guix~a
        initrd /EFI/guix~a
        options \"~a\"
    }~%"
                  #$label
                  #$kernel
                  #$initrd
                  (string-join (list #$@arguments))))))
  (define builder
  #~(call-with-output-file #$output
      (lambda (port)
        (format port
                "# This file was generated from your Guix configuration. Any changes
# will be lost upon reconfiguration.
menuentry")
        #$@(map menu-entry->gexp all-entries)
        #$@(if (pair? old-entries)
               #~(#$@(map submenu-entry->gexp old-entries))
               #~())
				(format port "
}~%"))))
  (computed-file "refind.conf" builder
                 #:options '(#:local-build? #t
                             #:substitutable? #f)))

(define install-refind #~(lambda (bootloader device mount-point) #t))

(define refind-bootloader
  (bootloader
   (name 'refind)
   (package grub-efi)
   (installer install-refind)
   (configuration-file "/boot/efi/EFI/refind/refind.conf")
   (configuration-file-generator refind-configuration-file)))
